Shareware Grab Bag/Shareware Grab Bag.iso/050/turboio.arc/DOS2IO-3.LIB

Text File | 1986-01-02 | 20.8 KB | 811 lines

(*
                          Dos2io-3.inc


    Dedicated to the public domain.

        -- Cole Brecheen
           17 August 1985
*)
{$V-} {Relaxes type checking on string parameters.}
{$U-,C-}{Enables keyboard buffering.}


PROCEDURE SetPtrFromEnd( FileHandle: INTEGER;
                 OffSetFromEnd: REAL );
LABEL EndProcedure;
VAR
  TmpPtr : BufferPtr;
  rgstr : RegPack;
  lngthnum : REAL;
  segnum : INTEGER;
BEGIN {SetPtrFromEnd}
  lngthnum := FileLength( FileHandle );
  IF lngthnum = 0
    THEN GOTO EndProcedure;
  WITH rgstr DO BEGIN
    a.h := $42; {command to move file read/write pointer}
    a.l := 0;
    {Zero in a.l means that pointer moves to offset bytes
    from the beginnning of the file.}
    b.x := FileHandle;

    RealToSegmented( lngthnum + OffSetFromEnd, c.x, d.x );
    msdos( rgstr );
    IF FlaggedError( flags )
      THEN BEGIN { writeln('setptrfromend error'); } {diag}
        PrintMessage( MessageType( a.x ) );
      END;
  END; {WITH rgstr}

  CheckInitialization;
    {From here down we're flushing any buffer that
    corresponds with this filehandle.}

  IF BufLstBase = nil
    THEN GOTO EndProcedure;
  TmpPtr := BufLstBase;
  WHILE (TmpPtr^.next <> nil)
    and
    (TmpPtr^.handle <> FileHandle) DO TmpPtr := TmpPtr^.next;
  IF TmpPtr^.handle = FileHandle
    THEN  tmpPtr^.ndx := BufSize + 1;
  EndProcedure:
END; {SetPtrFromEnd}


PROCEDURE SetPtrFromStart( FileHandle: INTEGER;
                   OffSetFromStart : REAL );
LABEL
  EndProcedure;
VAR
  TmpPtr : BufferPtr;
  rgstr : RegPack;
BEGIN {SetPtrFromStart}
  WITH rgstr DO BEGIN
    a.h := $42;
    {command to move file read/write pointer}
    a.l := 0;
    {moves pointer to offset bytes from the beginnning of the
    file}
    b.x := FileHandle;
    RealToSegmented( OffSetFromStart, c.x, d.x );
    msdos( rgstr );
    IF FlaggedError( flags )
      THEN BEGIN { writeln('setptrfromstart error'); } {diag}
        PrintMessage( MessageType( a.x ) );
      END;
  END; {WITH rgstr}

  CheckInitialization;
  IF BufLstBase = nil
    THEN GOTO EndProcedure;
  TmpPtr := BufLstBase;
  WHILE (TmpPtr^.next <> nil)
    and
    (TmpPtr^.handle <> FileHandle) DO TmpPtr := TmpPtr^.next;
  IF TmpPtr^.handle = FileHandle
    THEN  tmpPtr^.ndx := BufSize + 1;
  EndProcedure:
END; {SetPtrFromStart}



FUNCTION BytesToWord( lobyte, hibyte: INTEGER ): INTEGER;
    {Takes two bytes and stores them in a single word.  The
    last byte in the parameter list is most significant.}
BEGIN {BytesToWord}
  hibyte := swap( hibyte );
      {Reverses the order of the two bytes in hibyte.}
  BytesToWord := lobyte OR hibyte;
      {OR does bitwise addition in this language.}
END; {BytesToWord}


PROCEDURE BitRangeToInt( TheSet: BitSet;
                 LowBit, HighBit: INTEGER;
                 VAR answer:  INTEGER );
      {BitRangeToInt lets us specify the bits that store the
      value in which we're interested, and it loads that value
      into the last parameter in the list.}

  FUNCTION power(x,n:INTEGER): INTEGER;
    {Returns x raised to the nth power.}
  VAR w,z,i: INTEGER;
  BEGIN
    w := x; i := n;
    z := 1;
    WHILE i <> 0 DO
    BEGIN
      IF ODD(i) THEN z := z*w;
      i := i DIV 2;
      IF i <> 0
    THEN w := w*w;
    END;
    power := z;
  END; {power}

VAR
  tmp: RECORD
     CASE BOOLEAN of
       true: ( IntForm : INTEGER );
       false:( SetForm : BitSet );
       END;
  cnt : INTEGER;
BEGIN {BitRangeToInt}
  tmp.SetForm := TheSet;
  {Bit 15 is most significant.}
  answer := 0;
  FOR cnt := LowBit TO HighBit DO
    BEGIN
      IF cnt IN tmp.SetForm
    THEN answer := answer + power( 2,  cnt - LowBit );
    END;
END;  {BitRangeToInt}


PROCEDURE IntegerToDate( TheInt: INTEGER;
                 VAR month, day, year: INTEGER );
VAR
  TheSet : BitSet;
BEGIN {IntegerToDate}
  IntegerToBitSet( TheInt, TheSet );
  BitRangeToInt( TheSet, 0, 4, day );
  BitRangeToInt( TheSet, 5, 8, month );
  BitRangeToInt( TheSet, 9, 15, year );
  year := year + 80;
END; {IntegerToDate}



FUNCTION DateToInteger( month, day, year: INTEGER ): INTEGER;
VAR
  BitSet1, BitSet2: BitSet;
  TmpResult: integer;
  buf: BitRange;
BEGIN {DateToInteger}
  IF year > 1900 THEN
    year := year - 1900;
  IF year in [80 .. 199] THEN
    year := year - 80
  ELSE abort( 'Invalid year: ' + IntStr(year,0) );
  IF not (month in [1..12]) THEN
    abort( 'Invalid month: ' + IntStr(month,0) );
  IF not (day in [1..31]) THEN
    abort( 'Invalid day: ' + IntStr(day,0) );


  IntegerToBitSet( 0, BitSet2 );
  IntegerToBitSet( day, BitSet1 );
  FOR buf := 0 to 15 DO
    BEGIN
      IF buf in BitSet1
    THEN BitSet2 := BitSet2 + [buf];
    END;

  IntegerToBitSet( month, BitSet1 );
  FOR buf := 0 to 15 DO
    BEGIN
      IF buf in BitSet1
    THEN BitSet2 := BitSet2 + [buf + 5];
    END;

  IntegerToBitSet( year, BitSet1 );
  FOR buf := 0 to 15 DO
    BEGIN
      IF buf in BitSet1
    THEN BitSet2 := BitSet2 + [buf + 9];
    END;

  BitSetToInteger( BitSet2, TmpResult );
  DateToInteger := TmpResult;
END; {DateToInteger}



PROCEDURE IntegerToTime( TheInteger: INTEGER;
                 VAR hours, minutes, seconds : INTEGER );
VAR
  TheSet : BitSet;
BEGIN {IntegerToTime}
  IntegerToBitSet( TheInteger, TheSet );
  BitRangeToInt( TheSet, 11, 15, hours );
  BitRangeToInt( TheSet, 5, 10, minutes );
  BitRangeToInt( TheSet, 0, 4, seconds );
  seconds := seconds * 2;
    {We double seconds because the operating system stores
    this value in two-second increments.}
END; {IntegerToTime}



FUNCTION TimeToInteger( hours,
                minutes,
                seconds: INTEGER ): INTEGER;
VAR
  BitSet1, BitSet2: BitSet;
  TmpResult: integer;
  buf: BitRange;
BEGIN {TimeToInteger}
  IF not (hours in [0..23]) THEN
    abort( 'Invalid hour: ' + IntStr(hours,0) );
  IF not( minutes in [0..59] ) THEN
    abort( 'Invalid minute: ' + IntStr(minutes,0) );
  IF not( seconds in [0..59] ) THEN
    abort( 'Invalid second: ' + IntStr(seconds,0) );

  IntegerToBitSet( 0, BitSet2 );
  IntegerToBitSet( seconds div 2, BitSet1 );
  FOR buf := 0 to 15 DO
    BEGIN
      IF buf in BitSet1
    THEN BitSet2 := BitSet2 + [buf];
    END;

  IntegerToBitSet( minutes, BitSet1 );
  FOR buf := 0 to 15 DO
    BEGIN
      IF buf in BitSet1
    THEN BitSet2 := BitSet2 + [buf + 5];
    END;

  IntegerToBitSet( hours, BitSet1 );
  FOR buf := 0 to 15 DO
    BEGIN
      IF buf in BitSet1
    THEN BitSet2 := BitSet2 + [buf + 11];
    END;

  BitSetToInteger( BitSet2, TmpResult );
  TimeToInteger := TmpResult;
END; {TimeToInteger}



PROCEDURE AddToFile( FileName : dos2str80; FileHandle : INTEGER;
             message  : dos2str255 );
VAR
  SavedMessage  : ErrorMessage;
  AlreadyOpen   : BOOLEAN;

BEGIN  {AddToFile}
  IF FileName = null
    THEN abort( 'Always pass a file name to AddToFile.' );
  IF FileHandle > 4 {see D-15 of PC-DOS manual}
    THEN
      BEGIN
    AlreadyOpen := TRUE;
      END
    ELSE
      BEGIN
    AlreadyOpen := FALSE;
    SavedMessage := OpenFile( FileHandle, FileName );
    IF SavedMessage <> NoError
      THEN printmessage( SavedMessage );
      END;

  SetPtrFromEnd( FileHandle, -1 );
    {We move to -1 because we want to insert this data just
    before the eof char.}

  AddStr( message, #26 );
    {This will be the new eof marker.}
  WriteStr( FileHandle, message );
  PrintMessage( CloseHandle( FileHandle ) );
    {updates the file length}
  IF AlreadyOpen
    THEN
      BEGIN
    SavedMessage := OpenFile( FileHandle, FileName );
    IF SavedMessage <> NoError
      THEN printmessage( SavedMessage );
      END;
END;  {AddToFile}



 PROCEDURE SetFileDateAndTime( FileHandle,
                      month, day, year,
                      hours, minutes, seconds: INTEGER );
VAR
  rgstr : RegPack;
BEGIN {SetFileDateAndTime}
  WITH rgstr DO
    BEGIN
      a.h := $57;
      a.l := 1;
      b.x := FileHandle;
      d.x := DateToInteger( month, day, year );
      c.x := TimeToInteger( hours, minutes, seconds );
    {The reason for the swaps is that the bytes are reversed
    when date and time values are passed in registers.}
      msdos( rgstr );
      IF FlaggedError( flags )
    THEN PrintMessage( MessageType( a.x ) );
    END; {WITH rgstr}
END; {SetFileDateAndTime}



 PROCEDURE GetFileDateAndTime( FileHandle: INTEGER;
                      VAR month, day, year,
                      hours, minutes, seconds: INTEGER );
VAR
  rgstr : RegPack;
BEGIN {GetFileDateAndTime}
  WITH rgstr DO
    BEGIN
      a.h := $57;
      a.l := 0;
      b.x := FileHandle;
      msdos( rgstr );
      IF FlaggedError( flags ) THEN
    PrintMessage( MessageType( a.x ) )
      ELSE
    BEGIN
      IntegerToDate( d.x, month, day, year );
      IntegerToTime( c.x, hours, minutes, seconds );
    END;
    END; {WITH rgstr}
END; {GetFileDateAndTime}


 PROCEDURE LoadDTAinfo( VAR tmpstr : dos2str255 );
    {Pulls information about files from an area of memory
    called the Disk Transfer Address (DTA).  Used in both
    FindFirstFile and FindNextFile, below.}

  PROCEDURE ExtractTime( TheInteger : INTEGER;
                 VAR TheStr : dos2str80 );
  TYPE
    str8 = STRING[8];
  VAR
    hours, minutes, seconds : INTEGER;
    TheSet : BitSet;
    MinStr : str8;
    pm : BOOLEAN;
  BEGIN {ExtractTime}
    IntegerToTime( TheInteger, hours, minutes, seconds );
    {From here down we're formatting TheStr so that the
    string returned by LoadDTAinfo will look nice if it's
    written.}
{
    str( seconds:2, SecStr );
    IF SecStr[1] = ' '
      THEN SecStr[1] := '0';
    You can add this back in if you're interested in the
    seconds part of the file's time.
}
    str( minutes:2, MinStr );
    IF MinStr[1] = ' '
      THEN MinStr[1] := '0';
    pm := hours > 12;
    IF pm
      THEN hours := hours - 12;
    TheStr := concat( '  ', IntStr(hours,2), ':', MinStr );
    IF pm
      THEN TheStr := concat( TheStr, 'p' )
      ELSE TheStr := concat( TheStr, 'a' );
  END;  {ExtractTime}


  PROCEDURE ExtractDate( TheInteger : INTEGER;
                 VAR TheStr : dos2str80 );
  TYPE
    str8 = STRING[8];
  VAR
    month, day, year : INTEGER;
    TheSet : BitSet;
    YrStr, MnthStr, DayStr : str8;
  BEGIN {ExtractDate}
    IntegerToDate( TheInteger, month, day, year );
    str( day:2, DayStr );
    IF DayStr[1] = ' '
      THEN DayStr[1] := '0';
    TheStr := concat( IntStr(month,2),
              '-', DayStr,
              '-', IntStr(year,2) );
  END;  {ExtractDate}

LABEL 1;
TYPE
  str32 = STRING[32];
VAR
  rgstr : RegPack;
  FileSize : REAL;
  DTAinfo : dos2str255;
  SizeStr,
  datestr,
  timestr : str32;
  SubDirCode,
  cnt,
  index : INTEGER;
  LoWord, HiWord : INTEGER;
BEGIN {LoadDTAinfo}
  SizeStr := null;
  DateStr := null;
  TimeStr := null;

  WITH rgstr DO BEGIN
    a.h := $2F; {get Disk Transfer Address}
    msdos( rgstr );
      {ES:BX now contains the DTA}
    FillChar( DTAinfo, sizeof( DTAinfo ), CHR(0) );
    FOR cnt := 0 TO 42 DO
       mem[seg(DTAinfo):ofs(DTAinfo) + cnt] := mem[ES:b.x + cnt];
    {Transfers 43 bytes from the DTA into DTAinfo.}
  END; {WITH rgstr}

  SubDirCode := ord(DTAinfo[21]) and $10;
    {This sets SubDirCode to 16--that is, it turns on the
    fourth bit of SubDirCode--if the file found is a
    directory entry.  Otherwise, SubDirCode is set to 0.}

  IF SubDirCode <> 0 {That is, if the file is a sub-directory.}
    THEN SizeStr := '   <DIR>'
    ELSE
      BEGIN
    LoWord := BytesToWord( ORD(DTAinfo[26]), ORD(DTAinfo[27]) );
    HiWord := BytesToWord( ORD(DTAinfo[28]), ORD(DTAinfo[29]) );
    FileSize := SegmentedToReal( HiWord, LoWord );
    str( FileSize:0:0, SizeStr );
    WHILE length(SizeStr) < 8
      DO insert( ' ', SizeStr, 1 );
      END;

  ExtractTime( BytesToWord( ORD(DTAinfo[22]), ORD(DTAinfo[23]) ),
           timestr );
  ExtractDate( BytesToWord( ORD(DTAinfo[24]), ORD(DTAinfo[25]) ),
           datestr );
  WHILE length(DateStr) < 10
    DO insert( ' ', DateStr, 1 );

  tmpstr := null;
  FOR index := 30 TO 43 DO
    BEGIN
      tmpstr[0] := succ( tmpstr[0] );
      IF DTAinfo[ index ] = CHR(0)
    THEN
      BEGIN
        tmpstr[0] := pred( tmpstr[0] );
        GOTO 1;
      END
    ELSE tmpstr[ index - 29 ] := DTAinfo[ index ];
    END;
  1:
  WHILE length(TmpStr) < 12
    DO TmpStr := concat( TmpStr, ' ' );
  TmpStr := concat( TmpStr, SizeStr, datestr, timestr );
END;  {LoadDTAinfo}





TYPE
  DTAptr = ^DTA;
  DTA = array [1..128] of byte;
VAR
  DTAseg, DTAofs : INTEGER;
  TmpDTAptr : DTAptr;

PROCEDURE SaveDTA;
VAR
  rgstr : RegPack;
BEGIN {SaveDTA}
  WITH rgstr DO BEGIN
    a.h := $2F;
    msdos( rgstr );
    DTAseg := es;
    DTAofs := b.x;
    new( TmpDTAptr );
    ds := seg( TmpDTAptr^ );
    d.x := ofs( TmpDTAptr^ );
    a.h := $1A;
  END; {WITH rgstr}
  msdos( rgstr );
END; {SaveDTA}

PROCEDURE RestoreDTA;
VAR
  rgstr : RegPack;
BEGIN {RestoreDTA}
  dispose( TmpDTAptr );
  rgstr.ds := DTAseg;
  rgstr.d.x := DTAofs;
  rgstr.a.h := $1A;
  msdos( rgstr );
END; {RestoreDTA}


 FUNCTION FindFirstFile(FileName: dos2str80;
               VAR FileInfo: dos2str255): ErrorMessage;
VAR
  tmpset : BitSet;
  rgstr : RegPack;
  tmpstr : dos2str80;
BEGIN {FindFirstFile}
  FindFirstFile := NoError;
  FileInfo := null;
  tmpstr := FileName;
  MakeAsciiZ( tmpstr );
  WITH rgstr DO BEGIN
    d.x := ofs( tmpstr );
    ds := seg( tmpstr );
    TmpSet := [0,1,2,4];
    {We set four attribute bits:  read-only file, hidden
    file, system file, and sub-directory.  This allows us to
    find any of these files, plus normal files.}
    BitSetToInteger( TmpSet, c.x );
    a.h := $4E; {find first matching file}
    msdos( rgstr );
    IF FlaggedError( flags )
      THEN FindFirstFile := MessageType( a.x )
      ELSE LoadDTAinfo( FileInfo );
  END; {WITH rgstr}
END; {FindFirstFile}


 FUNCTION FindNextFile( VAR FileInfo : dos2str255 ): ErrorMessage;
VAR
  rgstr : RegPack;
BEGIN
  FindNextFile := NoError;
  FileInfo := null;
  WITH rgstr DO BEGIN
    a.h := $4F; {find next matching file}
    flags := 0;
    msdos( rgstr );
    IF FlaggedError( flags )
      THEN FindNextFile := MessageType( a.x )
      ELSE LoadDTAinfo( FileInfo );
  END; {WITH rgstr}
END; {FindNextFile}



 FUNCTION VolumeLabel( TheDrive: CHAR ): dos2str80;
    {Returns the label of the disk in TheDrive.}
VAR
  rgstr : RegPack;
  XFCB : RECORD
       prfx : array [1..7] of byte;
       fcb : array [0..36] of byte;
     END;
    {XFCB is an "Extended File Control Block." }
  bufstr : dos2str80;
  cnt : INTEGER;
BEGIN {VolumeLabel}
  lowerch( TheDrive );
  bufstr := null;
  fillchar( XFCB, sizeof(XFCB), '?' );
    {We fill XFCB with question marks because function $11
    does not take any other kind of wildcard.  The PC-DOS
    documentation says that question-mark wildcards are
    allowed, but neglects to mention that they are
    mandatory.}
  WITH XFCB DO
    BEGIN
      prfx[1] := $FF; {indicates an extended FCB}
      prfx[7] := $8; {attribute set to volume label}
      IF TheDrive = 'z'
    THEN fcb[0] := 0
    ELSE fcb[0] := ord(TheDrive) - 96 ;
    {sets 'a' to 1, 'b' to 2, etc.}
    END;

  WITH rgstr DO BEGIN
    ds := seg( XFCB );
    d.x := ofs( XFCB );
    a.h := $11; {Search for first entry.}
    msdos( rgstr );
    IF a.l = $FF
      THEN bufstr := 'unlabelled vol'
      ELSE
    BEGIN
      a.h := $2F; {get Disk Transfer Address}
      msdos( rgstr );
        {ES:BX now contains the DTA}
      FOR cnt := 8 to 18 DO
        AddStr( bufstr, chr(mem[es:b.x + cnt]) );
    {We do this because information from the search gets
    transferred into the DTA, not the extended file control
    block whose address we passed going into function $11.}
    END;
  END; {WITH rgstr}
  VolumeLabel := bufstr;
END; {VolumeLabel}



FUNCTION FreeDiskSpace( DriveLetter: CHAR;
                VAR FreeBytes: REAL ): ErrorMessage;
CONST
  upperdifference = 32;
VAR
  rgstr : RegPack;
BEGIN
  FreeDiskSpace := NoError;
  FreeBytes := 0;
  lowerch( DriveLetter );
  IF not (DriveLetter in ['a'..'z'])
    THEN halt;
  WITH rgstr DO BEGIN
    IF DriveLetter = 'z' {'z' means default drive}
      THEN d.l := 0
      ELSE d.l := ord( DriveLetter ) - 96;
    {turns an A into a 1, etc}
    a.h := $36;
    msdos( rgstr );
    IF a.x = $FFFF THEN
      FreeDiskSpace := InvalidDrive
    {AX returns $FFFF if the drive number was invalid.
    Otherwise, BX contains the number of available clusters,
    DX contains the total number of bytes per sector, and AX
    contains the number of sectors per cluster.}
    ELSE
      BEGIN
    FreeBytes := WordToReal(b.x) * WordToReal(a.x);
    FreeBytes := FreeBytes * WordToReal(c.x);
    {Division of this operation into two lines only reduces
    the width of the listing.}
      END;
  END; {WITH rgstr}
END; {FreeDiskSpace}



 FUNCTION CopyFile( OldHandle: integer;
           NewFileName: dos2str80 ): ErrorMessage;
TYPE
  memptr = RECORD
         addr : ^integer;
         size : INTEGER;
       END;

VAR
  TheDrive : char;
  MemoryPtr : memptr;
  NewHandle : INTEGER;
  SavedMessage : ErrorMessage;
  FreeBytes,
  FileSize,
  BytesToBeFreed,
  BytesToRead : REAL;


  PROCEDURE ReadOldFile( VAR MemoryPtr : memptr );
  LABEL EndProcedure;
  VAR
    rgstr : regpack;

    function min( first, second: real ): real;
    begin {min}
      if first < second
    then min := first
    else min := second;
    end; {min}

  BEGIN {ReadOldFile}
    IF BytesToRead <= 0 THEN
      BEGIN
    MemoryPtr.addr := nil;
    GOTO EndProcedure;
      END;
    with MemoryPtr DO
      BEGIN
    size := RealToWord( min( maxavail * 16,
                         min( SegSize - 1,
                              BytesToRead)));
    GetMem( addr, size );
    rgstr.c.x := size;
          {CX gets number of bytes to read.}
    rgstr.a.h := $3F;  {DOS Read From file Code}
    rgstr.b.x := OldHandle;
    rgstr.d.x := ofs( addr^ );
    rgstr.ds := seg( addr^ );
      END;
    msdos( rgstr );
    IF FlaggedError( rgstr.flags )
      THEN printmessage( messagetype( rgstr.a.x ) )
      ELSE BytesToRead := BytesToRead - MemoryPtr.size;
    EndProcedure:
  END; {ReadOldFile}


  PROCEDURE WriteNewFile( MemoryPtr : MemPtr );
  LABEL EndProcedure;
  VAR
    rgstr : regpack;
  BEGIN {WriteNewFile}
    IF MemoryPtr.addr = nil
      THEN GOTO EndProcedure;

    rgstr.b.x := NewHandle;
    rgstr.c.x := MemoryPtr.size;
    rgstr.ds := seg( MemoryPtr.addr^ );
    rgstr.d.x := ofs( MemoryPtr.addr^ );
    rgstr.a.h := $40;  {Write to a file or device.}
    msdos( rgstr );
    IF rgstr.a.x < rgstr.c.x
      {if fewer than c.x bytes were actually written}
      THEN
    BEGIN
      CopyFile := AccessDenied;
      SavedMessage := CloseHandle( NewHandle );
      WriteStr( outp, 'No room.' );
      halt;
    END;
    FreeMem( MemoryPtr.addr, MemoryPtr.size );
    EndProcedure:
  END; {WriteNewFile}



  PROCEDURE SetDateAndTime;
  VAR
    month, day, year,
    hours, minutes, seconds : INTEGER;
  BEGIN
    GetFileDateAndTime(OldHandle, month, day, year,
                          hours, minutes, seconds );
    SetFileDateAndTime(NewHandle, month, day, year,
                          hours, minutes, seconds );
  END; {SetDateAndTime}


LABEL
  EndProcedure;

begin {CopyFile}
  BytesToBeFreed := 0;
  CopyFile := NoError;
  FileSize := FileLength( OldHandle );
  BytesToRead := FileSize;

  IF pos(':', NewFileName) = 2 THEN
    TheDrive := NewFileName[1]
  ELSE TheDrive := 'z';
    {Determines the drive to which we're copying.
    'z' means "default drive" to FreeDiskSpace.}
  SavedMessage := FreeDiskSpace( TheDrive, FreeBytes );
  if SavedMessage <> NoError then
    goto EndProcedure;

  SavedMessage := OpenFile( NewHandle, NewFileName );
  if SavedMessage = NoError then
    begin
      BytesToBeFreed := FileLength( NewHandle );
      SavedMessage := CloseHandle( NewHandle );
    end
  else
    begin
      if SavedMessage <> FileNotFound then
    goto EndProcedure;
    end;

  IF FileSize > (FreeBytes + BytesToBeFreed) THEN
    BEGIN
      SavedMessage := AccessDenied;
    {This will have to stand for 'Not enough room.'}
      goto EndProcedure;
    END;

  SavedMessage := CreateFile(NewHandle, NewFileName);
  if SavedMessage <> NoError then
    goto EndProcedure;

  REPEAT
    ReadOldFile( MemoryPtr );
    WriteNewFile( MemoryPtr );
  UNTIL (BytesToRead <= 0);

  SetDateAndTime;

  SavedMessage := CloseHandle(NewHandle);
  EndProcedure:
  CopyFile := SavedMessage;
end; {CopyFile}